home *** CD-ROM | disk | FTP | other *** search
- /*
- ** $VER: Local2Email.br 1.51 (15.10.96)
- ** by Eirik Nicolai Synnes
- **
- ** Based on ML2Email.thor by Remco van Hooff
- **
- ** See SortMail.guide for documentation
- **
- */
-
- options results
-
- parse arg arguments
-
- /*
- ** Initialize some variables
- */
-
- template = 'SYSTEM/A'
-
- fromthor = 0; cfgread = 0
-
- EVE_ENTERMSG = 0 /* Enter message */
- EVE_REPLYMSG = 1 /* Reply message */
- EVE_FORWARDMSG = 9 /* Forward message (only for TCP/SOUP) */
-
- EDB_DELETED = 0 /* Event is deleted */
- EDB_PACKED = 1 /* Event is packed */
- EDB_DONE = 2 /* Event is done */
- EDB_ERROR = 3 /* Error performing this event */
- EDB_UNRECOVERABLE = 4 /* Event can not be undeleted */
- EDB_FREEZE = 5 /* Event is frozen. Will not be done as long as this flag is set. */
-
- CDB_MAIL = 1 /* Private mail conference. */
- CDB_NOT_ON_BBS = 15 /* This conference is not on the bbs. */
-
- UDB_DELETED = 0 /* User is deleted */
- UDB_UNRECOVERABLE = 1 /* User can not be undeleted */
-
- BDB_EVENTS_CHANGED = 5 /* Events changed after last event package was made. */
-
- /*
- ** Find/open Thor ARexx port
- */
-
- /* See if I'm run from Thor */
-
- if left(address(), 5) = 'THOR.' then do
- thorport = address()
- address(thorport)
- 'CURRENTSYSTEM STEM 'cursys
- if rc ~= 0 then do
- say 'CURRENTSYSTEM: 'THOR.LASTERROR
- exit(rc)
- end
- else fromthor = 1
- end
-
- /*
- ** Find/open BBSREAD ARexx port
- */
-
- if ~show('P', 'BBSREAD') then do
- address(command)
- 'Run >NIL: `GetEnv THOR/THORPath`bin/LoadBBSRead'
- 'WaitForPort BBSREAD'
- if rc ~= 0 then do
- say 'Couldn''t open BBSREAD''s ARexx port.'
- exit(rc)
- end
- end
-
- /*
- ** Parse arguments
- */
-
- address(bbsread)
-
- if ~fromthor then do
- if arguments = '?' | arguments = '' then do
- say 'Usage: 'template
- exit(0)
- end
- 'READARGS 'template args' CMDLINE 'arguments
- if rc ~= 0 then do
- say 'READARGS: 'BBSREAD.LASTERROR
- exit(rc)
- end
- cursys.BBSNAME = args.SYSTEM
- end
-
- /*
- ** Get system info
- */
-
-
- 'GETBBSDATA BBSNAME "'cursys.BBSNAME'" STEM 'bbsdata
- if rc ~= 0 then do
- say 'GETBBSDATA: 'BBSREAD.LASTERROR
- exit(rc)
- end
-
- /*
- ** Leave if there are no active changed events
- */
-
- if (bbsdata.NUMEVENTS = 0) | ~bittst(bbsdata.FLAGS, BDB_EVENTS_CHANGED) then exit(0)
-
- /*
- ** Find name of email conference
- */
-
- 'GETCONFLIST BBSNAME "'cursys.BBSNAME'" STEM 'conflist
- if rc ~= 0 then do
- say 'GETCONFLIST: 'BBSREAD.LASTERROR
- exit(rc)
- end
-
- mailcount = 0
- do i = 1 to conflist.COUNT
- 'GETCONFDATA "'cursys.BBSNAME'" "'conflist.i'" 'confdata
- if rc ~= 0 then do
- say 'GETCONFDATA: 'BBSREAD.LASTERROR
- exit(rc)
- end
- if bittst(confdata.FLAGS, CDB_MAIL) then do
- email = confdata.NAME; mailcount = mailcount + 1
- end
- end
-
- if symbol('email') ~= 'VAR' then do
- say 'Couldn''t find Email conference'
- exit(20)
- end
-
- if mailcount > 1 then email = readcfg(1)
-
- /*
- ** Main loop
- */
-
- do n = bbsdata.FIRSTEVENT to bbsdata.LASTEVENT
- drop eventtags. eventdata.
-
- changed = 0; crosspost = 0
-
- /* Read event data */
-
- 'READBREVENT "'cursys.BBSNAME'" EVENTNR 'n' DATASTEM 'eventdata' TAGSSTEM 'eventtags
- if rc ~= 0 then do
- say 'READBREVENT: 'BBSREAD.LASTERROR
- exit(rc)
- end
-
- /* Skip event if it is not a reply/enter or it is deleted, packed, etc. */
-
- if ~(eventdata.EVENTTYPE = EVE_ENTERMSG | eventdata.EVENTTYPE = EVE_REPLYMSG | eventdata.EVENTTYPE = EVE_FORWARDMSG) then iterate n
- if bittst(eventdata.FLAGS, EDB_DELETED) | bittst(eventdata.FLAGS, EDB_PACKED) | bittst(eventdata.FLAGS, EDB_DONE) | bittst(eventdata.FLAGS, EDB_ERROR) | bittst(eventdata.FLAGS, EDB_UNRECOVERABLE) | bittst(eventdata.FLAGS, EDB_FREEZE) then iterate n
-
- /* Split conferences and to-addresses into stems */
-
- if index(eventtags.CONFERENCE, ',') > 0 then do
- crosspost = 1; confs = eventtags.CONFERENCE; ccnt = 0
- do while index(confs, ',') > 0
- ccnt = ccnt + 1; confs.ccnt = left(confs, (index(confs, ',') - 1))
- confs = substr(confs, index(confs, ',') + 1)
- end
- ccnt = ccnt + 1; confs.ccnt = confs; confs.count = ccnt; drop confs ccnt
- end
- else do; confs.count = 1; confs.1 = eventtags.CONFERENCE; end
-
- if index(eventtags.TOADDR, ',') > 0 then do
- toaddrs = eventtags.TOADDR; acnt = 0
- do while index(toaddrs, ',') > 0
- acnt = acnt + 1; toaddrs.acnt = left(toaddrs, (index(toaddrs, ',') - 1))
- toaddrs = substr(toaddrs, index(toaddrs, ',') + 1)
- end
- acnt = acnt + 1; toaddrs.acnt = toaddrs; toaddrs.count = acnt; drop toaddrs acnt
- end
- else do; toaddrs.count = 1; toaddrs.1 = eventtags.TOADDR; end
-
- /* Replace local conferences with email conference and add reply address */
-
- do i = 1 to confs.count
- drop confdata.; unknown = 0
- 'GETCONFDATA "'cursys.BBSNAME'" "'confs.i'" 'confdata
- if rc ~= 0 then do
- if BBSREAD.LASTERROR = 'Unknown conference' then unknown = 1
- else do
- say 'GETCONFDATA: 'BBSREAD.LASTERROR
- exit(rc)
- end
- end
-
- if (~unknown) & (bittst(confdata.FLAGS, CDB_NOT_ON_BBS)) then do
- if cfgread = 0 then call readcfg(0); addradd = 0
-
- if trig.count > 0 then do m = 1 to trig.count
- if upper(trig.m.conf) = upper(confs.i) then do
- match = 0
- do j = 1 to toaddrs.count
- if upper(toaddrs.j) = upper(trig.m.addr) then match = 1
- end
- if ~match then do
- acnt = toaddrs.count + 1; toaddrs.acnt = trig.m.addr; toaddrs.count = acnt; addradd = 1
- end
- end
- end
-
- if addradd then confs.i = email
- changed = 1
- end
- end
-
- /* Recreate conference and to-address strings */
-
- eventtags.CONFERENCE = ''; mailfound = 0
- do i = 1 to confs.count
- if (upper(confs.i) ~= upper(email)) | (~mailfound) then eventtags.CONFERENCE = eventtags.CONFERENCE || confs.i || ','
- if (~mailfound) & (upper(confs.i) = upper(email)) then mailfound = 1
- end
- eventtags.CONFERENCE = strip(eventtags.CONFERENCE, 'B', ',')
-
- eventtags.TOADDR = ''
- do i = 1 to toaddrs.count
- eventtags.TOADDR = eventtags.TOADDR || toaddrs.i || ','
- end
- eventtags.TOADDR = strip(eventtags.TOADDR, 'B', ',')
-
- /* Replace names with corresponding address(es) */
-
- if (~crosspost) & (symbol('eventtags.TOADDR') = 'VAR') & (strip(eventtags.TOADDR, 'B') ~= '') & (length(eventtags.TOADDR) = length(compress(eventtags.TOADDR, '@#?*()|'))) then do
- drop user.
- 'SEARCHBRUSER "'cursys.BBSNAME'" STEM 'user' SEARCH "'eventtags.TOADDR'" NAME'
- if rc ~= 0 then do
- say 'SEARCHBRUSER: 'BBSREAD.LASTERROR
- exit(rc)
- end
- if result > 0 then do
- drop usertags. userdata.
- 'READBRUSER BBSNAME "'cursys.BBSNAME'" USERNR 'user.1.USERNR' TAGSSTEM 'usertags' DATASTEM 'userdata
- if rc ~= 0 then do
- say 'READBRUSER: 'BBSREAD.LASTERROR
- exit(rc)
- end
- if ~bittst(userdata.FLAGS, UDB_DELETED) & ~bittst(userdata.FLAGS, UDB_UNRECOVERABLE) then do
- eventtags.TOADDR = usertags.ADDRESS; changed = 1
- end
- end
- end
-
- if changed then do
- 'WRITEBREVENT BBSNAME "'cursys.BBSNAME'" EVENT 'eventdata.EVENTTYPE' STEM 'eventtags 'UPDATEEVENTNR 'n
- if rc ~= 0 then do
- say 'READBRUSER: 'BBSREAD.LASTERROR
- exit(rc)
- end
- end
- end
-
- exit(0)
-
- /*
- ** Procedures
- */
-
- readcfg: procedure expose cfgread trig. bbsdata.
- parse arg email
-
- foundcfg = 0; trigcnt = 0
-
- cfgpath = bbsdata.BBSPATH
- cfgfile = 'SortMail.cfg'
-
- if (right(cfgpath, 1) ~= '/') & (right(cfgpath, 1) ~= ':') then cfgpath = cfgpath || '/'
-
- if ~exists(cfgpath || cfgfile) then do
- say 'Couldn''t find SortMail.cfg'
- exit(30)
- end
-
- cfgopen = open(cf, cfgpath || cfgfile, 'R')
-
- address(bbsread)
-
- if cfgopen then do until eof(cf)
- entry = readln(cf)
- if ~email & upper(subword(entry, 1, 1)) = 'ACTION' then do
- 'READARGS TEMPLATE "TYPE/A,DESTSYS/K,DESTCONF/K,REPLYADDR/K,SCRIPTNAME/K,SCRIPTOPTS/K,FILENAME/K,DIRECTORY/K,SUBSTITUTE/K,WITH/K,HEADER/S,APPEND/S,NOBIN/S,CHECKDUPES/S,DONTADD/S,NOSTATS/S" STEM 'trigentry' CMDLINE 'subword(entry, 2)
- if rc ~= 0 then do; say 'READARGS: 'BBSREAD.LASTERROR; exit(rc); end
- if (upper(trigentry.TYPE) = 'COPY' | upper(trigentry.TYPE) = 'SPLITDIGEST') & symbol('trigentry.REPLYADDR') = 'VAR' then do
- trigcnt = trigcnt + 1; trig.trigcnt.conf = trigentry.DESTCONF; trig.trigcnt.addr = trigentry.REPLYADDR
- end
- trig.count = trigcnt; drop trigentry.
- end
- if email & upper(subword(entry, 1, 1)) = 'GLOBAL' then do
- 'READARGS TEMPLATE "SYSTEM/K,CONFERENCE/A,STATISTICS/S,NOWARN/S,LOGINSTATE/S" STEM 'trigentry' CMDLINE 'subword(entry, 2)
- if rc ~= 0 then do; say 'READARGS: 'BBSREAD.LASTERROR; exit(rc); end
- call close(cf)
- return(trigentry.CONFERENCE)
- end
- end
-
- cfgread = 1
-
- call close(cf)
-
- return(0)
-